setup_data functionsetup_data data functioncompute_group functioncompute_group row processing functionggproto() to create StatCircle;
setup_data and compute_group functions will be
inputsgeom_circlegeom_circle from ggforce; hope renewed
layer_data to look at the data
framelibrary(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.2.9000 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
create_circle <- function(data, n){
angles <- seq(from = 0,
to = 2 * pi,
length.out = n + 1)
data.frame(
x = cos(angles) * data$r + data$x0,
y = sin(angles) * data$r + data$y0,
data
)
}
StatCircle <- ggproto(`_class` = "StatCircle",
`_inherit` = Stat,
setup_data = function(data, params) {
if (data$group[1] == -1) {
nrows <- nrow(data)
data$group <- seq_len(nrows)
}
data # return data with a group variable
},
compute_group = function(data, scales, n = 5){create_circle(data, n = n)},
required_aes = c("x0", "y0", "r")
)
circles <- data.frame(x0 = c(-5,5), y0 = c(5, -5),
r = c(5, 4), class = c("A", "B"))
ggplot(circles) +
geom_polygon(stat = StatCircle,
aes(x0 = x0, y0 = y0,
r = r, fill = class))
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
ggplot(circles) +
geom_polygon(stat = StatCircle,
aes(x0 = x0, y0 = y0,
r = r, fill = class)) +
facet_wrap(~ class)
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
ggplot(cars) +
aes(x = speed, y = dist) +
geom_point() +
aes(x0 = speed, y0 = dist, r = 1) +
geom_polygon(stat = StatCircle) +
aes(fill = speed > 15) +
facet_wrap(~ speed > 15)
## Warning in cos(angles) * data$r: longer object length is not a multiple of
## shorter object length
## Warning in sin(angles) * data$r: longer object length is not a multiple of
## shorter object length
setup_data functionlibrary(tidyverse)
setup_data_circle <- function(data, params) {
if (data$group[1] == -1) {
nrows <- nrow(data)
data$group <- seq_len(nrows)
}
data # return data with a group variable
}
setup_data data functioncars %>%
slice(1:5) %>%
mutate(group = -1) %>% # no grouping neg one is default in ggplot2
setup_data_circle() # setup makes each row defines a group
## speed dist group
## 1 4 2 1
## 2 4 10 2
## 3 7 4 3
## 4 7 22 4
## 5 8 16 5
cars %>%
slice(5:20) %>%
mutate(group = 2) %>% # if a group is already defined
setup_data_circle() # setup data does not do anything
## speed dist group
## 1 8 16 2
## 2 9 10 2
## 3 10 18 2
## 4 10 26 2
## 5 10 34 2
## 6 11 17 2
## 7 11 28 2
## 8 12 14 2
## 9 12 20 2
## 10 12 24 2
## 11 12 28 2
## 12 13 26 2
## 13 13 34 2
## 14 13 34 2
## 15 13 46 2
## 16 14 26 2
compute_group functionWe write a routine that will act on each group in the data (in this case each row)
compute_group_circle <- function(data, scales, n = 5){
angles <- seq(from = 0,
to = 2 * pi,
length.out = n + 1)
data.frame(
x = cos(angles) * data$r + data$x0,
y = sin(angles) * data$r + data$y0#,
# data
)
}
compute_group row processing
functioncars %>%
rename(x0 = dist, y0 = speed) %>%
mutate(r = x0) %>%
.[1,] %>%
compute_group_circle(n = 6)
## x y
## 1 4 4.000000
## 2 3 5.732051
## 3 1 5.732051
## 4 0 4.000000
## 5 1 2.267949
## 6 3 2.267949
## 7 4 4.000000
cars %>%
rename(x0 = dist, y0 = speed) %>%
mutate(r = x0) %>%
.[5,] %>%
compute_group_circle(n = 6) %>%
ggplot() +
aes(x = x, y = y) +
geom_polygon(alpha = .5) +
coord_equal()
ggproto() to create StatCircle;
setup_data and compute_group functions will be
inputsStatCircle <- ggproto(`_class` = "StatCircle",
`_inherit` = Stat,
setup_data = setup_data_circle,
compute_group = compute_group_circle,
required_aes = c("x0", "y0", "r")
)
geom_circletest_df <- data.frame(
x0 = c(-5, 5),
y0 = c(5, -5),
r = c(5, 4),
class = c("a", "b")
)
cars %>%
slice(1:5) %>%
ggplot() +
aes(x = speed, y = dist) +
geom_point() +
aes(x0 = speed,
y0 = dist,
r = speed/6) +
coord_equal() ->
baseplot
baseplot +
geom_polygon(stat = StatCircle, n = 7, alpha = .2)
baseplot +
aes(fill = speed == 6) +
geom_polygon(stat = StatCircle, n = 7, alpha = .2)
## Warning in cos(angles) * data$r: longer object length is not a multiple of
## shorter object length
## Warning in cos(angles) * data$r + data$x0: longer object length is not a
## multiple of shorter object length
## Warning in sin(angles) * data$r: longer object length is not a multiple of
## shorter object length
## Warning in sin(angles) * data$r + data$y0: longer object length is not a
## multiple of shorter object length
## Warning: The following aesthetics were dropped during statistical transformation: x0,
## y0, and r.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
## the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
## variable into a factor?
baseplot +
aes(fill = speed > 6) +
geom_polygon(stat = StatCircle, n = 7, alpha = .2)
## Warning in cos(angles) * data$r: longer object length is not a multiple of
## shorter object length
## Warning in cos(angles) * data$r + data$x0: longer object length is not a
## multiple of shorter object length
## Warning in sin(angles) * data$r: longer object length is not a multiple of
## shorter object length
## Warning in sin(angles) * data$r + data$y0: longer object length is not a
## multiple of shorter object length
## Warning: The following aesthetics were dropped during statistical transformation: y0,
## x0, and r.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
## the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
## variable into a factor?
geom_circle from ggforce; hope renewedbaseplot +
aes(fill = speed > 6) +
ggforce::geom_circle(n = 5)
create_circle <- function(data, n){
angles <- seq(from = 0,
to = 2 * pi,
length.out = n + 1)
data.frame(
x = cos(angles) * data$r + data$x0,
y = sin(angles) * data$r + data$y0,
data
)
}
StatCircle <- ggproto(`_class` = "StatCircle",
`_inherit` = Stat,
setup_data = function(data, params) {
if (data$group[1] == -1) {
nrows <- nrow(data)
data$group <- seq_len(nrows)
}
data # return data with a group variable
},
compute_group = function(data, scales, n = 5){create_circle(data, n = n)},
required_aes = c("x0", "y0", "r")
)
circles <- data.frame(x0 = c(-5,5), y0 = c(5, -5),
r = c(5, 4), class = c("A", "B"))
ggplot(circles) +
geom_polygon(stat = StatCircle,
aes(x0 = x0, y0 = y0,
r = r, fill = class))
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
ggplot(circles) +
geom_polygon(stat = StatCircle,
aes(x0 = x0, y0 = y0,
r = r, fill = class)) +
facet_wrap(~ class)
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
ggplot(cars) +
aes(x = speed, y = dist) +
geom_point() +
aes(x0 = speed, y0 = dist, r = 1) +
geom_polygon(stat = StatCircle) +
aes(fill = speed > 15) +
facet_wrap(~ speed > 15)
## Warning in cos(angles) * data$r: longer object length is not a multiple of
## shorter object length
## Warning in sin(angles) * data$r: longer object length is not a multiple of
## shorter object length
ggforce:::StatCircle$compute_group
## <ggproto method>
## <Wrapper function>
## function (...)
## compute_group(..., self = self)
##
## <Inner function (f)>
## function (self, data, scales)
## {
## cli::cli_abort("Not implemented.")
## }
ggforce:::StatCircle$compute_panel
## <ggproto method>
## <Wrapper function>
## function (...)
## compute_panel(...)
##
## <Inner function (f)>
## function (data, scales, n = 360)
## {
## data$x <- NULL
## data$y <- NULL
## data$start <- 0
## data$end <- 2 * pi
## arcPaths(data, n + 1)
## }
ggforce:::StatCircle$setup_params
## <ggproto method>
## <Wrapper function>
## function (...)
## setup_params(...)
##
## <Inner function (f)>
## function (data, params)
## {
## params
## }
ggforce:::arcPaths
## function (data, n)
## {
## trans <- radial_trans(c(0, 1), c(0, 2 * pi), pad = 0)
## data <- data[data$start != data$end, ]
## data$nControl <- ceiling(n/(2 * pi) * abs(data$end - data$start))
## data$nControl[data$nControl < 3] <- 3
## extraData <- !names(data) %in% c("r0", "r", "start", "end",
## "group")
## data$group <- make_unique(as.character(data$group))
## paths <- lapply(seq_len(nrow(data)), function(i) {
## path <- data_frame0(a = seq(data$start[i], data$end[i],
## length.out = data$nControl[i]), r = data$r[i])
## if ("r0" %in% names(data)) {
## if (data$r0[i] != 0) {
## path <- vec_rbind(path, data_frame0(a = rev(path$a),
## r = data$r0[i]))
## }
## else {
## path <- vec_rbind(path, data_frame0(a = data$start[i],
## r = 0))
## }
## }
## path$group <- data$group[i]
## path$index <- seq(0, 1, length.out = nrow(path))
## path <- cbind(path, data[rep(i, nrow(path)), extraData,
## drop = FALSE])
## })
## paths <- vec_rbind(!!!paths)
## paths <- cbind(paths[, !names(paths) %in% c("r", "a")], trans$transform(paths$r,
## paths$a))
## paths$x <- paths$x + paths$x0
## paths$y <- paths$y + paths$y0
## if ("explode" %in% names(data)) {
## exploded <- data$explode != 0
## if (any(exploded)) {
## exploder <- trans$transform(data$explode[exploded],
## data$start[exploded] + (data$end[exploded] -
## data$start[exploded])/2)
## explodedPaths <- paths$group %in% which(exploded)
## exploderInd <- as.integer(factor(paths$group[explodedPaths]))
## paths$x[explodedPaths] <- paths$x[explodedPaths] +
## exploder$x[exploderInd]
## paths$y[explodedPaths] <- paths$y[explodedPaths] +
## exploder$y[exploderInd]
## }
## }
## paths[, !names(paths) %in% c("x0", "y0", "exploded")]
## }
## <bytecode: 0x7fe992d5cce8>
## <environment: namespace:ggforce>
layer_data to look at the
data framebaseplot +
geom_polygon(stat = StatCircle, n = 7, alpha = .2) ->
p1
layer_data(p1, 2)
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
## x y x0 y0 r x.1 y.1 PANEL group colour fill
## 1 4.666667 2.000000 4 2 0.6666667 4 2 1 1 NA #333333FF
## 2 4.415660 2.521221 4 2 0.6666667 4 2 1 1 NA #333333FF
## 3 3.851653 2.649952 4 2 0.6666667 4 2 1 1 NA #333333FF
## 4 3.399354 2.289256 4 2 0.6666667 4 2 1 1 NA #333333FF
## 5 3.399354 1.710744 4 2 0.6666667 4 2 1 1 NA #333333FF
## 6 3.851653 1.350048 4 2 0.6666667 4 2 1 1 NA #333333FF
## 7 4.415660 1.478779 4 2 0.6666667 4 2 1 1 NA #333333FF
## 8 4.666667 2.000000 4 2 0.6666667 4 2 1 1 NA #333333FF
## 9 4.666667 10.000000 4 10 0.6666667 4 10 1 2 NA #333333FF
## 10 4.415660 10.521221 4 10 0.6666667 4 10 1 2 NA #333333FF
## 11 3.851653 10.649952 4 10 0.6666667 4 10 1 2 NA #333333FF
## 12 3.399354 10.289256 4 10 0.6666667 4 10 1 2 NA #333333FF
## 13 3.399354 9.710744 4 10 0.6666667 4 10 1 2 NA #333333FF
## 14 3.851653 9.350048 4 10 0.6666667 4 10 1 2 NA #333333FF
## 15 4.415660 9.478779 4 10 0.6666667 4 10 1 2 NA #333333FF
## 16 4.666667 10.000000 4 10 0.6666667 4 10 1 2 NA #333333FF
## 17 8.166667 4.000000 7 4 1.1666667 7 4 1 3 NA #333333FF
## 18 7.727405 4.912137 7 4 1.1666667 7 4 1 3 NA #333333FF
## 19 6.740392 5.137416 7 4 1.1666667 7 4 1 3 NA #333333FF
## 20 5.948870 4.506198 7 4 1.1666667 7 4 1 3 NA #333333FF
## 21 5.948870 3.493802 7 4 1.1666667 7 4 1 3 NA #333333FF
## 22 6.740392 2.862584 7 4 1.1666667 7 4 1 3 NA #333333FF
## 23 7.727405 3.087863 7 4 1.1666667 7 4 1 3 NA #333333FF
## 24 8.166667 4.000000 7 4 1.1666667 7 4 1 3 NA #333333FF
## 25 8.166667 22.000000 7 22 1.1666667 7 22 1 4 NA #333333FF
## 26 7.727405 22.912137 7 22 1.1666667 7 22 1 4 NA #333333FF
## 27 6.740392 23.137416 7 22 1.1666667 7 22 1 4 NA #333333FF
## 28 5.948870 22.506198 7 22 1.1666667 7 22 1 4 NA #333333FF
## 29 5.948870 21.493802 7 22 1.1666667 7 22 1 4 NA #333333FF
## 30 6.740392 20.862584 7 22 1.1666667 7 22 1 4 NA #333333FF
## 31 7.727405 21.087863 7 22 1.1666667 7 22 1 4 NA #333333FF
## 32 8.166667 22.000000 7 22 1.1666667 7 22 1 4 NA #333333FF
## 33 9.333333 16.000000 8 16 1.3333333 8 16 1 5 NA #333333FF
## 34 8.831320 17.042442 8 16 1.3333333 8 16 1 5 NA #333333FF
## 35 7.703305 17.299904 8 16 1.3333333 8 16 1 5 NA #333333FF
## 36 6.798708 16.578512 8 16 1.3333333 8 16 1 5 NA #333333FF
## 37 6.798708 15.421488 8 16 1.3333333 8 16 1 5 NA #333333FF
## 38 7.703305 14.700096 8 16 1.3333333 8 16 1 5 NA #333333FF
## 39 8.831320 14.957558 8 16 1.3333333 8 16 1 5 NA #333333FF
## 40 9.333333 16.000000 8 16 1.3333333 8 16 1 5 NA #333333FF
## linewidth linetype alpha
## 1 0.5 1 0.2
## 2 0.5 1 0.2
## 3 0.5 1 0.2
## 4 0.5 1 0.2
## 5 0.5 1 0.2
## 6 0.5 1 0.2
## 7 0.5 1 0.2
## 8 0.5 1 0.2
## 9 0.5 1 0.2
## 10 0.5 1 0.2
## 11 0.5 1 0.2
## 12 0.5 1 0.2
## 13 0.5 1 0.2
## 14 0.5 1 0.2
## 15 0.5 1 0.2
## 16 0.5 1 0.2
## 17 0.5 1 0.2
## 18 0.5 1 0.2
## 19 0.5 1 0.2
## 20 0.5 1 0.2
## 21 0.5 1 0.2
## 22 0.5 1 0.2
## 23 0.5 1 0.2
## 24 0.5 1 0.2
## 25 0.5 1 0.2
## 26 0.5 1 0.2
## 27 0.5 1 0.2
## 28 0.5 1 0.2
## 29 0.5 1 0.2
## 30 0.5 1 0.2
## 31 0.5 1 0.2
## 32 0.5 1 0.2
## 33 0.5 1 0.2
## 34 0.5 1 0.2
## 35 0.5 1 0.2
## 36 0.5 1 0.2
## 37 0.5 1 0.2
## 38 0.5 1 0.2
## 39 0.5 1 0.2
## 40 0.5 1 0.2
baseplot +
aes(fill = speed > 6) +
geom_polygon(stat = StatCircle, n = 7, alpha = .2) ->
p2
layer_data(p2, 2) |>
slice(1:5)
## Warning in data.frame(x = cos(angles) * data$r + data$x0, y = sin(angles) * :
## row names were found from a short variable and have been discarded
## Warning in cos(angles) * data$r: longer object length is not a multiple of
## shorter object length
## Warning in cos(angles) * data$r + data$x0: longer object length is not a
## multiple of shorter object length
## Warning in sin(angles) * data$r: longer object length is not a multiple of
## shorter object length
## Warning in sin(angles) * data$r + data$y0: longer object length is not a
## multiple of shorter object length
## Warning: Computation failed in `stat_circle()`.
## Caused by error in `data.frame()`:
## ! arguments imply differing number of rows: 8, 3
## data frame with 0 columns and 0 rows